home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / tools / cie.lha / cie / goto-file.el < prev    next >
Lisp/Scheme  |  1993-06-21  |  6KB  |  148 lines
  1. ;;; goto-file.el
  2.  
  3. ;;; By binding goto-file to a key or mouse stroke, you can essentially
  4. ;;; make filenames "hot"; it will attempt to find that file in the 
  5. ;;; current buffer's default directory.  If no such file exists, then 
  6. ;;; it checks the current tags-table, gambling that it is one of your
  7. ;;; source files and will be tagged.
  8. ;;;
  9. ;;; Furthermore, it will try to go to the right location in the file.
  10. ;;; If there is an adjacent line number, then it will go to that line.
  11. ;;; Or if there is an adjacent grep pattern, then it will find that pattern.
  12. ;;;
  13. ;;; For instance, if you are in a shell and do an "ls", you can then click on
  14. ;;; any file name to open the file.  If you do a "make", you can click on any
  15. ;;; error msg to take you to the line of the error.  If you are in dbx, and it
  16. ;;; outputs a break or an assert outputs file/line, then you can simply click
  17. ;;; on the filename to take you to the line.  If you do a "grep", then you
  18. ;;; can simply click on the filename of the match that you want to go to.
  19. ;;; IMO, this is preferable to M-x compile or grep, because there is no need
  20. ;;; to proceed in order.  It also works everywhere: in source files, in
  21. ;;; shells, in night build logs, in mail buffers, etc.
  22.  
  23. ;;; Copyright (C) 1993, Intellection Inc.
  24. ;;;
  25. ;;; Author: Brian M Kennedy (kennedy@intellection.com)
  26. ;;;
  27. ;;; This program is free software; you can redistribute it and/or modify
  28. ;;; it under the terms of the GNU General Public License as published by
  29. ;;; the Free Software Foundation; either version 1, or (at your option)
  30. ;;; any later version.
  31. ;;;
  32. ;;; This program is distributed in the hope that it will be useful,
  33. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  34. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  35. ;;; GNU General Public License for more details.
  36. ;;;
  37. ;;; A copy of the GNU General Public License can be obtained from the
  38. ;;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  39.  
  40. ;;; 92/07/23  Brian M Kennedy  Original
  41.  
  42. (provide 'goto-file)
  43.  
  44. (require 'tags)
  45.  
  46.  
  47. (defvar goto-file-chars "-A-Za-z./_=+~#0-9"
  48.   "Characters that goto-file considers part of a filename.
  49.    Intentionally does not include (by default) ,:<> and quotes because
  50.    these are more often delimiters than part of the filename.")
  51.  
  52. (defvar goto-file-other-window-p t
  53.   "When non-nil, goto new file in other window.")
  54.  
  55. (defun goto-file (&optional dont-use-tags-p)
  56.   "Attempts to identify a filename at or around point.  If it finds one,
  57.    then it attempts to find a line number of the form 'line nn' on the 
  58.    same line as the filename.  If there is no line number, then it checks
  59.    if the filename was followed by a colon.  If so, it assumes it is a 
  60.    grep-style pattern that was matched in the file.
  61.    It then tries to find a file by that filename in the current-dirctory.
  62.    If there is none and the optional argument is nil, then it attempts to
  63.    identify a file that has been tagged with the same name in order to get a
  64.    full pathname.
  65.    If it finds a file (either way), then it opens it in another window.
  66.    If there was line number information, then it will goto that line.
  67.    If not, and there was a grep-style pattern, then it searches for that
  68.    pattern in the file (and sets it up so that you can search for additional
  69.    matches via incremental search)."
  70.   (interactive "P")
  71.   (let ((filename nil)
  72.     (basename nil)
  73.     (file     nil)
  74.     (line     nil)
  75.     (pattern  nil))
  76.     (save-excursion
  77.       ;; Get filename
  78.       (skip-chars-backward goto-file-chars)
  79.       (let (start-point base-point end-point)
  80.     (setq start-point (point))
  81.     (skip-chars-forward "./~")  ;; strip leading context info for tagfile lookup
  82.     (setq base-point (point))
  83.     (skip-chars-forward goto-file-chars)
  84.     (setq end-point (point))
  85.     (setq filename (buffer-substring start-point end-point))
  86.     (setq basename (buffer-substring base-point end-point)) )
  87.       ;; Get pattern
  88.       (if (looking-at ":")
  89.       (progn (forward-char 1)
  90.          (setq pattern (buffer-substring (point)
  91.                          (progn (end-of-line) (point)))) ))
  92.       ;; Get line
  93.       (cond ((looking-at "([0-9]+")
  94.          (forward-char 1)
  95.          (setq line (string-to-int 
  96.              (buffer-substring (point)
  97.                        (progn (skip-chars-forward "0-9")
  98.                           (point) )))) )
  99.         ((looking-at ".*line [0-9]")
  100.          (re-search-forward ".*line ")
  101.          (setq line (string-to-int 
  102.              (buffer-substring (point)
  103.                        (progn (skip-chars-forward "0-9")
  104.                           (point) )))) )
  105.         ((re-search-backward "line [0-9]"
  106.                  (save-excursion (beginning-of-line) (point))
  107.                  t)
  108.          (forward-char 5)
  109.          (setq line (string-to-int 
  110.              (buffer-substring (point)
  111.                        (progn (skip-chars-forward "0-9")
  112.                           (point) )))) )
  113.         ))
  114.     ;; Goto the file
  115.     (if filename
  116.     (let ((fullname (expand-file-name filename)))
  117.       (if (and (not dont-use-tags-p)
  118.            (not (and fullname (file-exists-p fullname))))
  119.           (setq fullname (expand-tagged-file-name basename)))
  120.       (if (and fullname (file-exists-p fullname))
  121.           (progn
  122.         (if goto-file-other-window-p
  123.             (find-file-other-window fullname)
  124.           (find-file fullname))
  125.         (cond (line    (goto-line line))
  126.               (pattern (setq search-last-string pattern)
  127.                    (goto-char (point-min))
  128.                    (search-forward pattern nil t) )
  129.               ))
  130.         (if dont-use-tags-p
  131.         (error "No file named %s is in current directory." filename)
  132.           (error "No file named %s is in current or tagged directories." filename)
  133.           ) ))
  134.       (error "No filename found at point.") )))
  135.  
  136.  
  137.  
  138. (defun expand-tagged-file-name (filename)
  139.   "Find a tagged file with a name that includes 'filename' in it.
  140.    If one is found, return that file's expanded filename.
  141.    Otherwise, return nil." 
  142.   ;; Find the tagged file
  143.   (save-excursion
  144.     (visit-tags-table-buffer)
  145.     (beginning-of-buffer)
  146.     (if (re-search-forward (concat "\f\n\\(.*/\\)?" filename ",") nil t)
  147.     (expand-file-name (file-of-tag) (file-name-directory tags-file-name)) )))
  148.